home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / calc202a.lha / calc-2.02a / calc-maint.el < prev    next >
Lisp/Scheme  |  1993-06-01  |  16KB  |  467 lines
  1. ;; Calculator for GNU Emacs, maintenance routines
  2. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
  3. ;; Written by Dave Gillespie, daveg@synaptics.com.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23.  
  24.  
  25. (defun calc-compile ()
  26.   "Compile all parts of Calc.
  27. Unix usage:
  28.      emacs -batch -l calc-maint -f calc-compile"
  29.   (interactive)
  30.   (if (equal (user-full-name) "David Gillespie")
  31.       (load "~/lisp/newbytecomp"))
  32.   (setq byte-compile-verbose t)
  33.   (if noninteractive
  34.       (let ((old-message (symbol-function 'message))
  35.         (old-write-region (symbol-function 'write-region))
  36.         (comp-was-func nil)
  37.         (comp-len 0))
  38.     (unwind-protect
  39.         (progn
  40.           (fset 'message (symbol-function 'calc-compile-message))
  41.           (fset 'write-region (symbol-function 'calc-compile-write-region))
  42.           (calc-do-compile))
  43.       (fset 'message old-message)
  44.       (fset 'write-region old-write-region)))
  45.     (calc-do-compile))
  46. )
  47.  
  48. (defun calc-do-compile ()
  49.   (let ((make-backup-files nil)
  50.     (changed-rules nil)
  51.     (changed-units nil)
  52.     (message-bug (string-match "^18.\\([0-4][0-9]\\|5[0-6]\\)"
  53.                    emacs-version)))
  54.     (setq max-lisp-eval-depth (max 400 max-lisp-eval-depth))
  55.     (setq byte-compile-warnings nil)
  56.  
  57.     ;; Make sure we're in the right directory.
  58.     (find-file "calc.el")
  59.     (if (= (buffer-size) 0)
  60.     (error "This command must be used in the Calc source directory."))
  61.  
  62.     ;; Make sure current directory is in load-path.
  63.     (setq load-path (cons default-directory load-path))
  64.     (load "calc-macs.el" nil t t)
  65.     (provide 'calc)
  66.     (provide 'calc-ext)
  67.  
  68.     ;; Compile all the source files.
  69.     (let ((files (append
  70.           '("calc.el" "calc-ext.el")
  71.           (sort (directory-files
  72.              default-directory nil
  73.              "\\`\\(calc-.[^x].*\\|macedit\\)\\.el\\'")
  74.             'string<))))
  75.       (while files
  76.     (if (file-newer-than-file-p (car files) (concat (car files) "c"))
  77.         (progn
  78.           (if (string-match "calc-rules" (car files))
  79.           (setq changed-rules t))
  80.           (if (string-match "calc-units" (car files))
  81.           (setq changed-units t))
  82.           (or message-bug (message ""))
  83.           (byte-compile-file (car files)))
  84.       (message "File %s is up to date." (car files)))
  85.     (if (string-match "calc\\(-ext\\)?.el" (car files))
  86.         (load (concat (car files) "c") nil t t))
  87.     (setq files (cdr files))))
  88.  
  89.     (if (or changed-units changed-rules)
  90.     (condition-case err
  91.         (progn
  92.  
  93.           ;; Pre-build the units table.
  94.           (if changed-units
  95.           (progn
  96.             (or message-bug (message ""))
  97.             (save-excursion
  98.               (calc-create-buffer)
  99.               (math-build-units-table))
  100.             (find-file "calc-units.elc")
  101.             (goto-char (point-max))
  102.             (insert "\n(setq math-units-table '"
  103.                 (prin1-to-string math-units-table)
  104.                 ")\n")
  105.             (save-buffer)))
  106.  
  107.           ;; Pre-build rewrite rules for j D, j M, etc.
  108.           (if (and changed-rules (not (string-match "^19" emacs-version)))
  109.           (let ((rules nil))
  110.             (or message-bug (message ""))
  111.             (find-file "calc-rules.elc")
  112.             (goto-char (point-min))
  113.             (while (re-search-forward "defun calc-\\([A-Za-z]*Rules\\)"
  114.                           nil t)
  115.               (setq rules (cons (buffer-substring (match-beginning 1)
  116.                               (match-end 1))
  117.                     rules)))
  118.             (goto-char (point-min))
  119.             (re-search-forward "\n(defun calc-[A-Za-z]*Rules")
  120.             (beginning-of-line)
  121.             (delete-region (point) (point-max))
  122.             (mapcar (function
  123.                  (lambda (v)
  124.                    (let* ((vv (intern (concat "var-" v)))
  125.                       (val (save-excursion
  126.                          (calc-create-buffer)
  127.                          (calc-var-value vv))))
  128.                  (insert "\n(defun calc-" v " () '"
  129.                      (prin1-to-string val) ")\n"))))
  130.                 (sort rules 'string<))
  131.             (save-buffer))))
  132.       (error (message "Unable to pre-build tables %s" err))))
  133.     (message "Done.  Don't forget to install with \"make public\" or \"make private\"."))
  134. )
  135.  
  136. (defun calc-compile-message (fmt &rest args)
  137.   (cond ((and (= (length args) 2)
  138.           (stringp (car args))
  139.           (string-match ".elc?\\'" (car args))
  140.           (symbolp (nth 1 args)))
  141.      (let ((name (symbol-name (nth 1 args))))
  142.        (princ (if comp-was-func ", " "  "))
  143.        (if (and comp-was-func (eq (string-match comp-was-func name) 0))
  144.            (setq name (substring name (1- (length comp-was-func))))
  145.          (setq comp-was-func (if (string-match "\\`[a-zA-Z]+-" name)
  146.                      (substring name 0 (match-end 0))
  147.                    " ")))
  148.        (if (> (+ comp-len (length name)) 75)
  149.            (progn
  150.          (princ "\n  ")
  151.          (setq comp-len 0)))
  152.        (princ name)
  153.        (send-string-to-terminal "")  ; cause an fflush(stdout)
  154.        (setq comp-len (+ comp-len 2 (length name)))))
  155.     ((and (setq comp-was-func nil
  156.             comp-len 0)
  157.           (= (length args) 1)
  158.           (stringp (car args))
  159.           (string-match ".elc?\\'" (car args)))
  160.      (or (string-match "Saving file %s..." fmt)
  161.          (funcall old-message fmt (file-name-nondirectory (car args)))))
  162.     ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\.$" fmt)
  163.      (send-string-to-terminal (apply 'format fmt args)))
  164.     ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\. *done$" fmt)
  165.      (send-string-to-terminal "done\n"))
  166.     (t (apply old-message fmt args)))
  167. )
  168.  
  169. (defun calc-compile-write-region (start end filename &optional append visit)
  170.   (if (eq visit t)
  171.       (set-buffer-auto-saved))
  172.   (if (and (string-match "\\.elc" filename)
  173.        (= start (point-min))
  174.        (= end (point-max)))
  175.       (save-excursion
  176.     (goto-char (point-min))
  177.     (if (search-forward "\n(require (quote calc-macs))\n" nil t)
  178.         (replace-match ""))
  179.     (setq end (point-max))))
  180.   (funcall old-write-region start end filename append 'quietly)
  181.   (message "Wrote %s" filename)
  182.   nil
  183. )
  184.  
  185.  
  186.  
  187. (defun calc-split-tutorial (&optional force)
  188.   (interactive "P")
  189.   (calc-split-manual force 1))
  190.  
  191.  
  192. (defun calc-split-reference (&optional force)
  193.   (interactive "P")
  194.   (calc-split-manual force 2))
  195.  
  196.  
  197. (defun calc-split-manual (&optional force part)
  198.   "Split the Calc manual into separate Tutorial and Reference manuals.
  199. Use this if your TeX installation is too small-minded to handle
  200. calc.texinfo all at once.
  201. Usage:  C-x C-f calc.texinfo RET
  202.         M-x calc-split-manual RET"
  203.   (interactive "P")
  204.   (or (let ((case-fold-search t))
  205.     (string-match "calc\\.texinfo" (buffer-name)))
  206.       force
  207.       (error "This command should be used in the calc.texinfo buffer."))
  208.   (let ((srcbuf (current-buffer))
  209.     tutpos refpos endpos (maxpos (point-max)))
  210.     (goto-char 1)
  211.     (search-forward "@c [tutorial]")
  212.     (beginning-of-line)
  213.     (setq tutpos (point))
  214.     (search-forward "@c [reference]")
  215.     (beginning-of-line)
  216.     (setq refpos (point))
  217.     (search-forward "@c [end]")
  218.     (beginning-of-line)
  219.     (setq endpos (point))
  220.     (or (eq part 2)
  221.     (progn
  222.       (find-file "calctut.tex")
  223.       (erase-buffer)
  224.       (insert-buffer-substring srcbuf 1 refpos)
  225.       (insert-buffer-substring srcbuf endpos maxpos)
  226.       (calc-split-volume "I" "ref" "Tutorial" "Reference")
  227.       (save-buffer)))
  228.     (or (eq part 1)
  229.     (progn
  230.       (find-file "calcref.tex")
  231.       (erase-buffer)
  232.       (insert-buffer-substring srcbuf 1 tutpos)
  233.       (insert "\n@tex\n\\global\\advance\\chapno by 1\n@end tex\n")
  234.       (insert-buffer-substring srcbuf refpos maxpos)
  235.       (calc-split-volume "II" "tut" "Reference" "Tutorial")
  236.       (save-buffer)))
  237.     (switch-to-buffer srcbuf)
  238.     (goto-char 1))
  239.   (message (cond ((eq part 1) "Wrote file calctut.tex")
  240.          ((eq part 2) "Wrote file calcref.tex")
  241.          (t "Wrote files calctut.tex and calcref.tex")))
  242. )
  243.  
  244. (defun calc-split-volume (number fix name other-name)
  245.   (goto-char 1)
  246.   (search-forward "@c [title]\n")
  247.   (search-forward "Manual")
  248.   (delete-backward-char 6)
  249.   (insert name)
  250.   (search-forward "@c [volume]\n")
  251.   (insert "@sp 1\n@center Volume " number ": " name "\n")
  252.   (let ((pat (format "@c \\[fix-%s \\(.*\\)\\]\n" fix)))
  253.     (while (re-search-forward pat nil t)
  254.       (let ((topic (buffer-substring (match-beginning 1) (match-end 1))))
  255.     (re-search-forward "@\\(p?xref\\){[^}]*}")
  256.     (let ((cmd (buffer-substring (match-beginning 1) (match-end 1))))
  257.       (delete-region (match-beginning 0) (match-end 0))
  258.       (insert (if (equal cmd "pxref") "see" "See")
  259.           " ``" topic "'' in @emph{the Calc "
  260.           other-name "}")))))
  261.   (goto-char 1)
  262.   (while (search-forward "@c [when-split]\n" nil t)
  263.     (while (looking-at "@c ")
  264.       (delete-char 3)
  265.       (forward-line 1)))
  266.   (goto-char 1)
  267.   (while (search-forward "@c [not-split]\n" nil t)
  268.     (while (not (looking-at "@c"))
  269.       (insert "@c ")
  270.       (forward-line 1)))
  271. )
  272.  
  273.  
  274. (defun calc-inline-summary ()
  275.   "Make a special \"calcsum.tex\" file to be used with main manual."
  276.   (calc-split-summary nil t)
  277. )
  278.  
  279. (defun calc-split-summary (&optional force in-line)
  280.   "Make a special \"calcsum.tex\" file with just the Calc summary."
  281.   (interactive "P")
  282.   (or (let ((case-fold-search t))
  283.     (string-match "calc\\.texinfo" (buffer-name)))
  284.       force
  285.       (error "This command should be used in the calc.texinfo buffer."))
  286.   (let ((srcbuf (current-buffer))
  287.     begpos sumpos endpos midpos)
  288.     (goto-char 1)
  289.     (search-forward "{Calc Manual}")
  290.     (backward-char 1)
  291.     (delete-backward-char 6)
  292.     (insert "Summary")
  293.     (search-forward "@c [begin]")
  294.     (beginning-of-line)
  295.     (setq begpos (point))
  296.     (search-forward "@c [summary]")
  297.     (beginning-of-line)
  298.     (setq sumpos (point))
  299.     (search-forward "@c [end-summary]")
  300.     (beginning-of-line)
  301.     (setq endpos (point))
  302.     (find-file "calcsum.tex")
  303.     (erase-buffer)
  304.     (insert-buffer-substring srcbuf 1 begpos)
  305.     (insert "@tex\n"
  306.         "\\global\\advance\\appendixno2\n"
  307.         "\\gdef\\xref#1.{See ``#1.''}\n")
  308.     (setq midpos (point))
  309.     (insert "@end tex\n")
  310.     (insert-buffer-substring srcbuf sumpos endpos)
  311.     (insert "@bye\n")
  312.     (goto-char 1)
  313.     (if (search-forward "{. a b c" nil t)
  314.     (replace-match "{... a b c"))
  315.     (goto-char 1)
  316.     (if in-line
  317.     (let ((buf (current-buffer))
  318.           (page nil))
  319.       (find-file "calc.aux")
  320.       (if (> (buffer-size) 0)
  321.           (progn
  322.         (goto-char 1)
  323.         (re-search-forward "{Summary-pg}{\\([0-9]+\\)}")
  324.         (setq page (string-to-int (buffer-substring (match-beginning 1)
  325.                                 (match-end 1))))))
  326.       (switch-to-buffer buf)
  327.       (if page
  328.           (progn
  329.         (message "Adjusting starting page number to %d" page)
  330.         (goto-char midpos)
  331.         (insert (format "\\global\\pageno=%d\n" page)))
  332.         (message "Unable to find page number from calc.aux")))
  333.       (if (search-forward "@c smallbook" nil t)
  334.       (progn   ; activate "smallbook" format for compactness
  335.         (beginning-of-line)
  336.         (forward-char 1)
  337.         (delete-char 2))))
  338.     (let ((buf (current-buffer)))
  339.       (find-file "calc.ky")
  340.       (if (> (buffer-size) 0)
  341.       (let ((ibuf (current-buffer)))
  342.         (message "Mixing in page numbers from Key Index (calc.ky)")
  343.         (switch-to-buffer buf)
  344.         (goto-char 1)
  345.         (search-forward "notes at the end")
  346.         (insert "; the number in italics is\n"
  347.             "the page number where the command is described")
  348.         (while (re-search-forward
  349.             "@r{.*@: *\\([^ ]\\(.*[^ ]\\)?\\) *@:.*@:.*@:\\(.*\\)@:.*}"
  350.             nil t)
  351.           (let ((key (buffer-substring (match-beginning 1) (match-end 1)))
  352.             (pos (match-beginning 3))
  353.             num)
  354.         (set-buffer ibuf)
  355.         (goto-char 1)
  356.         (let ((p '( ( "I H " . "H I " )  ; oops!
  357.                 ( "@@ ' \"" . "@@" ) ( "h m s" . "@@" )
  358.                 ( "\\\\" . "{\\tt\\indexbackslash }" )
  359.                 ( "_" . "{\\_}" )
  360.                 ( "\\^" . "{\\tt\\hat}" )
  361.                 ( "<" . "{\\tt\\less}" )
  362.                 ( ">" . "{\\tt\\gtr}" )
  363.                 ( "\"" ) ( "@{" ) ( "@}" )
  364.                 ( "~" ) ( "|" ) ( "@@" )
  365.                 ( "\\+" . "{\\tt\\char43}" )
  366.                 ( "# l" . "# L" )
  367.                 ( "I f I" . "f I" ) ( "I f Q" . "f Q" )
  368.                 ( "V &" . "&" ) ( "C-u " . "" ) ))
  369.               (case-fold-search nil))
  370.           (while p
  371.             (if (string-match (car (car p)) key)
  372.             (setq key (concat (substring key 0 (match-beginning 0))
  373.                       (or (cdr (car p))
  374.                           (format "{\\tt\\char'%03o}"
  375.                               (aref key (1- (match-end
  376.                                      0)))))
  377.                       (substring key (match-end 0)))))
  378.             (setq p (cdr p)))
  379.           (setq num (and (search-forward (format "\\entry {%s}{" key)
  380.                          nil t)
  381.                  (looking-at "[0-9]+")
  382.                  (buffer-substring (point) (match-end 0)))))
  383.         (set-buffer buf)
  384.         (goto-char pos)
  385.         (insert "@pgref{" (or num "") "}")))
  386.         (goto-char midpos)
  387.         (insert "\\gdef\\pgref#1{\\hbox to 2em{\\indsl\\hss#1}\\ \\ }\n"))
  388.     (message
  389.      "Unable to find Key Index (calc.ky); no page numbers inserted"))
  390.       (switch-to-buffer buf))
  391.     (save-buffer))
  392.   (message "Wrote file calcsum.tex")
  393. )
  394.  
  395.  
  396.  
  397. (defun calc-public-autoloads ()
  398.   "Modify the public \"default\" file to contain the necessary autoload and
  399. global-set-key commands for Calc."
  400.   (interactive)
  401.   (let ((home default-directory)
  402.     (p load-path)
  403.     instbuf name)
  404.     (while (and p
  405.         (not (file-exists-p
  406.               (setq name (expand-file-name "default" (car p)))))
  407.         (not (file-exists-p
  408.               (setq name (expand-file-name "default.el" (car p))))))
  409.       (setq p (cdr p)))
  410.     (or p (error "Unable to find \"default\" file.  Create one and try again."))
  411.     (find-file name)
  412.     (if buffer-read-only (error "No write permission for \"%s\"" buffer-file-name))
  413.     (goto-char (point-max))
  414.     (calc-add-autoloads home "calc-public-autoloads"))
  415. )
  416.  
  417. (defun calc-private-autoloads ()
  418.   "Modify the user's \".emacs\" file to contain the necessary autoload and
  419. global-set-key commands for Calc."
  420.   (interactive)
  421.   (let ((home default-directory))
  422.     (find-file "~/.emacs")
  423.     (goto-char (point-max))
  424.     (calc-add-autoloads home "calc-private-autoloads"))
  425. )
  426.  
  427. (defun calc-add-autoloads (home cmd)
  428.   (barf-if-buffer-read-only)
  429.   (let (top)
  430.     (if (and (re-search-backward ";;; Commands added by calc-.*-autoloads"
  431.                  nil t)
  432.          (setq top (point))
  433.          (search-forward ";;; End of Calc autoloads" nil t))
  434.     (progn
  435.       (forward-line 1)
  436.       (message "(Removing previous autoloads)")
  437.       (delete-region top (point)))
  438.       (insert "\n\n")
  439.       (backward-char 1)))
  440.   (insert ";;; Commands added by " cmd " on "
  441.       (current-time-string) ".
  442. \(autoload 'calc-dispatch       \"calc\" \"Calculator Options\" t)
  443. \(autoload 'full-calc           \"calc\" \"Full-screen Calculator\" t)
  444. \(autoload 'full-calc-keypad       \"calc\" \"Full-screen X Calculator\" t)
  445. \(autoload 'calc-eval           \"calc\" \"Use Calculator from Lisp\")
  446. \(autoload 'defmath           \"calc\" nil t t)
  447. \(autoload 'calc               \"calc\" \"Calculator Mode\" t)
  448. \(autoload 'quick-calc           \"calc\" \"Quick Calculator\" t)
  449. \(autoload 'calc-keypad           \"calc\" \"X windows Calculator\" t)
  450. \(autoload 'calc-embedded       \"calc\" \"Use Calc inside any buffer\" t)
  451. \(autoload 'calc-embedded-activate  \"calc\" \"Activate =>'s in buffer\" t)
  452. \(autoload 'calc-grab-region       \"calc\" \"Grab region of Calc data\" t)
  453. \(autoload 'calc-grab-rectangle       \"calc\" \"Grab rectangle of data\" t)
  454. \(autoload 'edit-kbd-macro       \"macedit\" \"Edit Keyboard Macro\" t)
  455. \(autoload 'edit-last-kbd-macro       \"macedit\" \"Edit Keyboard Macro\" t)
  456. \(autoload 'read-kbd-macro       \"macedit\" \"Read Keyboard Macro\" t)
  457. \(setq load-path (append load-path (list \"" (directory-file-name home) "\")))
  458. \(global-set-key \"\\e#\" 'calc-dispatch)
  459. ;;; End of Calc autoloads.\n")
  460.   (let ((trim-versions-without-asking t))
  461.     (save-buffer))
  462. )
  463.  
  464.  
  465.  
  466. ;;; End.
  467.